Week4:ビジネスにおける予測と分析結果の報告 ビジネス課題解決のためのデータ分析基礎(事例と手法)(3)

dat.path <- "https://lms.gacco.org/asset-v1:gacco+ga063+2016_04+type@asset+block/dummydata_A.csv"
dat <- read.csv(file(dat.path, encoding = "Shift-JIS"))

head(dat)
##   ID X3大都市圏か否か 世帯人員  就業人員 住居の所有関係 就業.非就業の別
## 1 A1  0_3大都市圏以外    2_2人 1_1人以下       1_持ち家          1_就業
## 2 A2  0_3大都市圏以外    2_2人 1_1人以下       1_持ち家          1_就業
## 3 A3  0_3大都市圏以外    2_2人 1_1人以下       1_持ち家          1_就業
## 4 A4  0_3大都市圏以外    2_2人 1_1人以下       1_持ち家          1_就業
## 5 A5  0_3大都市圏以外    2_2人 1_1人以下       1_持ち家          1_就業
## 6 A6  0_3大都市圏以外    2_2人 1_1人以下       1_持ち家          1_就業
##   年齢階級.5歳階級. 年齢階級.65歳未満か否か. 集計用乗率 年間収入.円.
## 1        1_30歳未満               1_65歳未満   538.5333    4,216,755
## 2        1_30歳未満               1_65歳未満   538.5333    4,362,659
## 3        1_30歳未満               1_65歳未満   538.5333    4,601,661
## 4        1_30歳未満               1_65歳未満   538.5333    4,737,544
## 5        1_30歳未満               1_65歳未満   538.5333    4,491,853
## 6        1_30歳未満               1_65歳未満   538.5333    4,628,420
##   消費支出額.合計.   食費 住居費 光熱.水道費 家具.家事用品費
## 1          541,403 55,410    897      13,965           8,725
## 2          122,635 25,878  1,153      12,253           2,425
## 3          387,940 29,352    924      13,822           2,060
## 4          164,740 27,001  1,413      12,142           4,130
## 5          198,961 37,167  1,190      10,702          12,547
## 6          139,568 37,234    686      12,447           4,460
##   被服及び履物費 保健医療費 交通.通信費 教育費 教養娯楽費 その他の消費支出
## 1          6,693      2,061      15,578      0     21,878          416,193
## 2         16,491      8,031      28,731      0     16,019           11,649
## 3          9,120      5,648      23,313      0     22,067          281,630
## 4          5,578      3,434      29,252      0     17,897           63,890
## 5          7,708     11,680      13,447      0      4,611           99,905
## 6          3,662      3,243      22,205      0     49,172            6,455
head(dat[c("食費","年間収入.円.")])
##     食費 年間収入.円.
## 1 55,410    4,216,755
## 2 25,878    4,362,659
## 3 29,352    4,601,661
## 4 27,001    4,737,544
## 5 37,167    4,491,853
## 6 37,234    4,628,420

カンマ区切りの数値を数値型に変換

colnames(dat[,c(10:ncol(dat))])
##  [1] "年間収入.円."     "消費支出額.合計." "食費"            
##  [4] "住居費"           "光熱.水道費"      "家具.家事用品費" 
##  [7] "被服及び履物費"   "保健医療費"       "交通.通信費"     
## [10] "教育費"           "教養娯楽費"       "その他の消費支出"
dat2 <- apply(dat[,c(10:ncol(dat))], 1:2, function(x){return (as.integer(gsub(",","",x)))})
head(dat2, 3)
##      年間収入.円. 消費支出額.合計.  食費 住居費 光熱.水道費
## [1,]      4216755           541403 55410    897       13965
## [2,]      4362659           122635 25878   1153       12253
## [3,]      4601661           387940 29352    924       13822
##      家具.家事用品費 被服及び履物費 保健医療費 交通.通信費 教育費
## [1,]            8725           6693       2061       15578      0
## [2,]            2425          16491       8031       28731      0
## [3,]            2060           9120       5648       23313      0
##      教養娯楽費 その他の消費支出
## [1,]      21878           416193
## [2,]      16019            11649
## [3,]      22067           281630
head(dat[,c(1:9)])
##   ID X3大都市圏か否か 世帯人員  就業人員 住居の所有関係 就業.非就業の別
## 1 A1  0_3大都市圏以外    2_2人 1_1人以下       1_持ち家          1_就業
## 2 A2  0_3大都市圏以外    2_2人 1_1人以下       1_持ち家          1_就業
## 3 A3  0_3大都市圏以外    2_2人 1_1人以下       1_持ち家          1_就業
## 4 A4  0_3大都市圏以外    2_2人 1_1人以下       1_持ち家          1_就業
## 5 A5  0_3大都市圏以外    2_2人 1_1人以下       1_持ち家          1_就業
## 6 A6  0_3大都市圏以外    2_2人 1_1人以下       1_持ち家          1_就業
##   年齢階級.5歳階級. 年齢階級.65歳未満か否か. 集計用乗率
## 1        1_30歳未満               1_65歳未満   538.5333
## 2        1_30歳未満               1_65歳未満   538.5333
## 3        1_30歳未満               1_65歳未満   538.5333
## 4        1_30歳未満               1_65歳未満   538.5333
## 5        1_30歳未満               1_65歳未満   538.5333
## 6        1_30歳未満               1_65歳未満   538.5333
dat2 <- cbind(dat[,c(1:9)], dat2)
head(dat2, 3)
##   ID X3大都市圏か否か 世帯人員  就業人員 住居の所有関係 就業.非就業の別
## 1 A1  0_3大都市圏以外    2_2人 1_1人以下       1_持ち家          1_就業
## 2 A2  0_3大都市圏以外    2_2人 1_1人以下       1_持ち家          1_就業
## 3 A3  0_3大都市圏以外    2_2人 1_1人以下       1_持ち家          1_就業
##   年齢階級.5歳階級. 年齢階級.65歳未満か否か. 集計用乗率 年間収入.円.
## 1        1_30歳未満               1_65歳未満   538.5333      4216755
## 2        1_30歳未満               1_65歳未満   538.5333      4362659
## 3        1_30歳未満               1_65歳未満   538.5333      4601661
##   消費支出額.合計.  食費 住居費 光熱.水道費 家具.家事用品費 被服及び履物費
## 1           541403 55410    897       13965            8725           6693
## 2           122635 25878   1153       12253            2425          16491
## 3           387940 29352    924       13822            2060           9120
##   保健医療費 交通.通信費 教育費 教養娯楽費 その他の消費支出
## 1       2061       15578      0      21878           416193
## 2       8031       28731      0      16019            11649
## 3       5648       23313      0      22067           281630
summary(dat2)
##        ID              X3大都市圏か否か      世帯人員         就業人員   
##  A1     :   1   0_3大都市圏以外:6018    2_2人    :4077   1_1人以下:5415  
##  A10    :   1   1_3大都市圏    :3982    3_3人以上:5923   2_2人以上:4585  
##  A100   :   1                                                            
##  A1000  :   1                                                            
##  A10000 :   1                                                            
##  A1001  :   1                                                            
##  (Other):9994                                                            
##       住居の所有関係 就業.非就業の別  年齢階級.5歳階級.
##  1_持ち家    :7821   1_就業  :7349   9_65歳以上:2952   
##  2_借家・借間:2179   2_非就業:2651   7_55〜59歳:1122   
##                                      6_50〜54歳:1023   
##                                      5_45〜49歳: 951   
##                                      4_40〜44歳: 927   
##                                      8_60〜64歳: 894   
##                                      (Other)   :2131   
##  年齢階級.65歳未満か否か.   集計用乗率      年間収入.円.     
##  1_65歳未満:7048          Min.   : 510.1   Min.   : 1987335  
##  2_65歳以上:2952          1st Qu.: 568.0   1st Qu.: 4365962  
##                           Median : 599.8   Median : 5993425  
##                           Mean   : 694.8   Mean   : 6213681  
##                           3rd Qu.: 811.6   3rd Qu.: 7942727  
##                           Max.   :1365.9   Max.   :12251614  
##                                                              
##  消費支出額.合計.       食費            住居費           光熱.水道費   
##  Min.   :  70370   Min.   :  9094   Min.   :      1.0   Min.   : 3893  
##  1st Qu.: 199213   1st Qu.: 43994   1st Qu.:    725.8   1st Qu.:12671  
##  Median : 259628   Median : 57522   Median :   3464.0   Median :16236  
##  Mean   : 291878   Mean   : 65594   Mean   :  17487.3   Mean   :18488  
##  3rd Qu.: 342923   3rd Qu.: 84098   3rd Qu.:  22085.0   3rd Qu.:23161  
##  Max.   :2523213   Max.   :226852   Max.   :1040029.0   Max.   :75631  
##                                                                        
##  家具.家事用品費  被服及び履物費     保健医療費      交通.通信費     
##  Min.   :    75   Min.   :    77   Min.   :   101   Min.   :    126  
##  1st Qu.:  2839   1st Qu.:  3763   1st Qu.:  3787   1st Qu.:  10338  
##  Median :  5595   Median :  7468   Median :  7618   Median :  23272  
##  Mean   :  9214   Mean   : 11873   Mean   : 13239   Mean   :  44037  
##  3rd Qu.: 11081   3rd Qu.: 14547   3rd Qu.: 15444   3rd Qu.:  49090  
##  Max.   :252301   Max.   :306524   Max.   :450453   Max.   :1359528  
##                                                                      
##      教育費          教養娯楽費     その他の消費支出 
##  Min.   :      0   Min.   :   362   Min.   :    631  
##  1st Qu.:      0   1st Qu.: 11768   1st Qu.:  24284  
##  Median :   1600   Median : 20969   Median :  43228  
##  Mean   :  14293   Mean   : 30329   Mean   :  67319  
##  3rd Qu.:  12451   3rd Qu.: 37538   3rd Qu.:  78361  
##  Max.   :2142757   Max.   :867614   Max.   :1551469  
##

単回帰

res.lm <- lm(食費~ 年間収入.円., data = dat2)
summary(res.lm)
## 
## Call:
## lm(formula = 食費 ~ 年間収入.円., data = dat2)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -75085 -14203  -1759  10536 135115 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  1.009e+04  7.260e+02   13.89   <2e-16 ***
## 年間収入.円. 8.933e-03  1.109e-04   80.52   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 22750 on 9998 degrees of freedom
## Multiple R-squared:  0.3934, Adjusted R-squared:  0.3933 
## F-statistic:  6483 on 1 and 9998 DF,  p-value: < 2.2e-16

グラフ化

# ```{r results = 'asis', comment = NA} にしておいて

library(rCharts)
n1 <- rPlot(食費 ~ 年間収入.円., data = dat2, type="point")
n1$print(include_assets=TRUE)
# うまくグラフが出ない
# 名前を変えてみる
colnames(dat2)[grep("年間収入",colnames(dat2))] <- "年間収入円"
n1 <- rPlot(食費 ~ 年間収入円, data = dat2, type="point")
n1$print(include_assets=TRUE)
# でた。ドットがダメらしい

# 線形回帰の線を重ねてみる
#range年間収入円 <- c(min(dat2$年間収入円) : max(dat2$年間収入円))
range年間収入円 <- dat2$年間収入円
predict食費 <- res.lm$coefficients[["(Intercept)"]] + res.lm$coefficients[["年間収入.円."]] * range年間収入円
dat.lm <- data.frame(predict食費, 年間収入円 = range年間収入円)

nrow(dat.lm)

[1] 10000

head(dat.lm)

predict食費 年間収入円 1 47755.38 4216755 2 49058.76 4362659 3 51193.80 4601661 4 52407.66 4737544 5 50212.87 4491853 6 51432.84 4628420

# 試しプロット
#rPlot(predict食費 ~ 年間収入円, data = dat.lm, type="line")

# 重ねてプロット
n1 <- rPlot(食費 ~ 年間収入円, data = dat2, type="point")
n1$layer(predict食費 ~ 年間収入円, data = dat.lm, type="line")
n1$print(include_assets=TRUE)
#n1$show("inline", include_assets = FALSE)


# テストの答え
# これもプロットしてみるか
ans食費 <- res.lm$coefficients[["(Intercept)"]] + res.lm$coefficients[["年間収入.円."]] * 6000000
dat.ans <- data.frame(食費=ans食費, 年間収入円=6000000, 種類="答え", サイズ=10)

range年間収入円 <- dat2$年間収入円
predict食費 <- res.lm$coefficients[["(Intercept)"]] + res.lm$coefficients[["年間収入.円."]] * range年間収入円
dat.lm <- data.frame(食費=predict食費, 年間収入円 = range年間収入円, 種類="予測", サイズ=1)

dat.3 <- data.frame(食費=dat2$食費, 年間収入円=dat2$年間収入円, 種類="実績", サイズ=1)

# 重ねてプロット
n1 <- rPlot(食費 ~ 年間収入円, data = dat.3, type="point", color="種類", size="サイズ")
n1$layer(predict食費 ~ 年間収入円, data = dat.lm, type="line", color="種類")
n1$layer(ans食費 ~ 年間収入円, data = dat.ans, type="point", color="種類", size="サイズ")
n1$print(include_assets=TRUE)